Contents

Contents

#install.packages(c("patchwork", "tidylog", "leaflet", "htmltools", "highcharter"))
library(patchwork)
library(tidyverse)
library(tidylog)
── Attaching packages ────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────── tidyverse 1.3.1 ──
 ggplot2 3.3.5      purrr   0.3.4
 tibble  3.1.6      dplyr   1.0.7
 tidyr   1.1.4      stringr 1.4.0
 readr   2.1.1      forcats 0.5.1
── Conflicts ───────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────── tidyverse_conflicts() ──
 dplyr::filter() masks stats::filter()
 dplyr::lag()    masks stats::lag()
Attaching package: ‘tidylog’
The following objects are masked from ‘package:dplyr’:

    add_count, add_tally, anti_join, count, distinct, distinct_all,
    distinct_at, distinct_if, filter, filter_all, filter_at, filter_if,
    full_join, group_by, group_by_all, group_by_at, group_by_if,
    inner_join, left_join, mutate, mutate_all, mutate_at, mutate_if,
    relocate, rename, rename_all, rename_at, rename_if, rename_with,
    right_join, sample_frac, sample_n, select, select_all, select_at,
    select_if, semi_join, slice, slice_head, slice_max, slice_min,
    slice_sample, slice_tail, summarise, summarise_all, summarise_at,
    summarise_if, summarize, summarize_all, summarize_at, summarize_if,
    tally, top_frac, top_n, transmute, transmute_all, transmute_at,
    transmute_if, ungroup
The following objects are masked from ‘package:tidyr’:

    drop_na, fill, gather, pivot_longer, pivot_wider, replace_na,
    spread, uncount
The following object is masked from ‘package:stats’:

    filter
options(repr.plot.width = 16, repr.plot.height = 8)

ggplot() +
  geom_bar(data = diamonds,
           aes(x = cut, fill = cut)
           ) +
  labs(x = "Cut of the Diamond", y = "Frequency") +
  theme(legend.position = "none") -> p1
ggplot() +
  geom_bar(data = diamonds,
           aes(x = color, fill = color)
           ) +
  labs(x = "Color of the Diamond", y = "Frequency") +
  theme(legend.position = "none") -> p2
ggplot() +
  geom_point(data = diamonds,
           aes(x = carat, y = price, color = cut)
           ) +
  labs(x = "Weight of the Diamond", y = "Price of the Diamond", color = "") +
  theme(legend.position = "bottom") -> p3
ggplot() +
  geom_boxplot(data = diamonds,
           aes(x = price, y = clarity, fill = cut)
           ) +
  labs(y = "Clarity of the Diamond", x = "Price of the Diamond", fill = "") +
  theme(legend.position = "bottom") -> p4
p1; p2; p3; p4
../../../_images/base_6_03.png ../../../_images/base_6_12.png ../../../_images/base_6_22.png ../../../_images/base_6_32.png
p1 + p2 + p3 
../../../_images/base_7_03.png
(p1 + p2) / p3
../../../_images/base_8_03.png
p1 | (p2 + p3)
../../../_images/base_9_03.png
p1 | (p2 / p3)
../../../_images/base_10_03.png
options(repr.plot.width = 16, repr.plot.height = 16)

(p1 + p2) / (p3 + p4)
../../../_images/base_11_03.png
(p1 + p2) / (p3 + p4) +
  plot_annotation(
  title = 'The surprising truth about diamonds',
  subtitle = 'These plots will reveal untold secrets about one of our beloved data-sets',
  caption = 'Disclaimer: None of these plots are insightful',
  tag_levels = c('a', '1'),
  tag_prefix = 'Fig. ',
  tag_sep = '.',
  tag_suffix = ':'
  ) &
  theme(
    plot.tag.position = c(0, 1),
    plot.tag = element_text(size = 9, hjust = 0, vjust = 0, color = "steelblue")
    )
../../../_images/base_12_03.png
options(repr.plot.width = 16, repr.plot.height = 8)

(p1 + plot_spacer() + p2 + plot_spacer() + p3)
../../../_images/base_13_03.png
options(repr.plot.width = 16, repr.plot.height = 16)

p1 + p2 + p3 + p4 + 
  plot_layout(widths = c(2, 1))
../../../_images/base_14_03.png
p1 + p2 + p3 + p4 + 
  plot_layout(
    widths = c(2, 1),
    heights = unit(c(5, 1), c('cm', 'null'))
    )
../../../_images/base_15_03.png
layout <- "
##BBBB
AACCDD
##CCDD
"
p2 + p3 + p4 + p1 + 
  plot_layout(design = layout)
../../../_images/base_16_03.png
layout <- c(
  area(t = 2, l = 1, b = 5, r = 4),
  area(t = 1, l = 3, b = 3, r = 5)
  )

p3 + p4 + 
  plot_layout(design = layout)
../../../_images/base_17_03.png
layout <- '
A##
#B#
##C
'
wrap_plots(A = p1, B = p2, C = p3, design = layout)
../../../_images/base_18_03.png
library(urbnmapr)

ggplot() +
  geom_polygon(
    data = states, 
    aes(x = long, y = lat, group = group, fill = state_abbv)
    ) +
  coord_fixed(1.3) +
  ggthemes::theme_map() + 
  theme(legend.position = "none") +
  labs(title = "Fixed!!") -> mymap

mymap + p1 + p2 + p3
../../../_images/base_19_03.png
head(states)
A tibble: 6 × 9
longlatorderholepiecegroupstate_fipsstate_abbvstate_name
<dbl><dbl><int><lgl><fct><fct><chr><chr><chr>
-88.4732331.893861FALSE101.101ALAlabama
-88.4688831.930262FALSE101.101ALAlabama
-88.4686631.933173FALSE101.101ALAlabama
-88.4550432.039724FALSE101.101ALAlabama
-88.4549632.040585FALSE101.101ALAlabama
-88.4534232.053056FALSE101.101ALAlabama
head(counties)
A tibble: 6 × 12
longlatorderholepiecegroupcounty_fipsstate_abbvstate_fipscounty_namefips_classstate_name
<dbl><dbl><int><lgl><fct><fct><chr><chr><chr><chr><chr><chr>
-86.9176032.664171FALSE101001.101001AL01Autauga CountyH1Alabama
-86.8165732.660122FALSE101001.101001AL01Autauga CountyH1Alabama
-86.7133932.661733FALSE101001.101001AL01Autauga CountyH1Alabama
-86.7142232.705694FALSE101001.101001AL01Autauga CountyH1Alabama
-86.4131232.707395FALSE101001.101001AL01Autauga CountyH1Alabama
-86.4111732.409946FALSE101001.101001AL01Autauga CountyH1Alabama
ggplot() +
  geom_polygon(
      data = states, 
      aes(
          x = long, 
          y = lat, 
          group = group),
      fill = "white", 
      color = "steelblue"
  ) +
  coord_fixed(1.3) 
../../../_images/base_22_03.png
ggplot() +
  geom_polygon(
      data = states, 
      aes(
          x = long, 
          y = lat, 
          group = group, 
          fill = state_name),
      color = "white"
      ) +
  coord_fixed(1.3) +
  ggthemes::theme_map() +
  theme(legend.position = "none")
../../../_images/base_23_03.png
head(statedata)
A tibble: 6 × 6
yearstate_fipsstate_namehhpophoratemedhhincome
<int><chr><chr><int><dbl><int>
201501Alabama 18463800.681432944700
201502Alaska 2501830.631186070600
201504Arizona 24630120.620617851000
201505Arkansas 11446570.654603142000
201506California128954710.537221964600
201508Colorado 20745170.638942563500
states %>%
  left_join(
      statedata, 
      by = c("state_fips", "state_name")
  ) -> state.df
left_join: added 4 columns (year, hhpop, horate, medhhincome)
           > rows only in x        0
           > rows only in y  (     0)
           > matched rows     83,933
           >                 ========
           > rows total       83,933
head(state.df)
A tibble: 6 × 13
longlatorderholepiecegroupstate_fipsstate_abbvstate_nameyearhhpophoratemedhhincome
<dbl><dbl><int><lgl><fct><fct><chr><chr><chr><int><int><dbl><int>
-88.4732331.893861FALSE101.101ALAlabama201518463800.681432944700
-88.4688831.930262FALSE101.101ALAlabama201518463800.681432944700
-88.4686631.933173FALSE101.101ALAlabama201518463800.681432944700
-88.4550432.039724FALSE101.101ALAlabama201518463800.681432944700
-88.4549632.040585FALSE101.101ALAlabama201518463800.681432944700
-88.4534232.053056FALSE101.101ALAlabama201518463800.681432944700
options(repr.plot.width = 24, repr.plot.height = 16)

ggplot() +
  geom_polygon(
      data = state.df, 
      aes(
          x = long, 
          y = lat, 
          group = group, 
          fill = medhhincome
          ),
          color = "white"
  ) +
  coord_fixed(1.3) +
  ggthemes::theme_map() +
  labs(
    title = "Median Household Income in the States (2015)",
    fill = "Median Household Income"
        ) +
  scale_fill_viridis_c(option = "magma") +
  theme(
      legend.position = "bottom",
      legend.text = element_text(size = 14),
      legend.key.width = unit(5, 'cm'),
      title = element_text(size = 20, face = "bold")
  ) 
../../../_images/base_27_03.png
counties %>%
  left_join(
      countydata, 
      by = c("county_fips")
  ) -> county.df
left_join: added 4 columns (year, hhpop, horate, medhhincome)
           > rows only in x         0
           > rows only in y  (      0)
           > matched rows     208,874
           >                 =========
           > rows total       208,874
ggplot() +
  geom_polygon(data = county.df, 
               aes(x = long, y = lat, group = group, fill = medhhincome),
               color = "white", size = 0.05) +
  coord_fixed(1.3) +
  ggthemes::theme_map() +
  theme(
      legend.position = "bottom",
      legend.text = element_text(size = 14),
      legend.key.width = unit(5, 'cm'),
      title = element_text(size = 20, face = "bold")
  ) +
  labs(
    title = "Median Household Income in the Counties (2015)",
    fill = "Median Household Income"
        ) +
  scale_fill_viridis_c(option = "magma")
../../../_images/base_29_03.png
county.df %>%
  filter(state_abbv == "FL") %>%
  ggplot() +
  geom_polygon(
               aes(x = long, y = lat, group = group,
                   fill = medhhincome),
               color = "white", size = 0.05
               ) +
  coord_fixed(1.3) +
  ggthemes::theme_map() +
  theme(
      legend.position = "bottom",
      legend.text = element_text(size = 14),
      legend.key.width = unit(5, 'cm'),
      title = element_text(size = 20, face = "bold")
  ) +
  labs(
    title = "Median Household Income in Floria Counties (2015)",
    fill = "Median Household Income"
        ) +
  scale_fill_viridis_c(option = "plasma")
filter: removed 203,791 rows (98%), 5,083 rows remaining
../../../_images/base_30_12.png
library(tigris)
options(tigris_use_cache = TRUE)

places(
  state = "NH", cb = TRUE, year = 2018, progress_bar = FALSE
  ) -> places.nh
To enable 
caching of data, set `options(tigris_use_cache = TRUE)` in your R script or .Rprofile.
places.nh %>%
    head()
Registered S3 method overwritten by 'geojsonsf':
  method        from   
  print.geojson geojson
A sf: 6 × 10
STATEFPPLACEFPPLACENSAFFGEOIDGEOIDNAMELSADALANDAWATERgeometry
<chr><chr><chr><chr><chr><chr><chr><dbl><dbl><POLYGON [°]>
13361860023780881600000US33618603361860Pittsfield 57 4114545 0POLYGON ((-71.34923 43.2990...
23367460026297381600000US33674603367460Sanbornville57 4106641 3626POLYGON ((-71.04123 43.5649...
33387140023780991600000US33871403387140Woodsville 57 2271155 63295POLYGON ((-72.04107 44.1542...
43312900008735671600000US33129003312900Claremont 251117661372323426POLYGON ((-72.41538 43.3802...
53311300023780551600000US33113003311300Charlestown 57 2107485 121062POLYGON ((-72.43447 43.2304...
63378340026297441600000US33783403378340Walpole 57 3152287 27471POLYGON ((-72.43535 43.0751...
places.nh %>%
  fortify(region = "GEOID") -> nh.df

names(nh.df)
  1. 'STATEFP'
  2. 'PLACEFP'
  3. 'PLACENS'
  4. 'AFFGEOID'
  5. 'GEOID'
  6. 'NAME'
  7. 'LSAD'
  8. 'ALAND'
  9. 'AWATER'
  10. 'geometry'
nh.df %>%
    head()
A sf: 6 × 10
STATEFPPLACEFPPLACENSAFFGEOIDGEOIDNAMELSADALANDAWATERgeometry
<chr><chr><chr><chr><chr><chr><chr><dbl><dbl><POLYGON [°]>
13361860023780881600000US33618603361860Pittsfield 57 4114545 0POLYGON ((-71.34923 43.2990...
23367460026297381600000US33674603367460Sanbornville57 4106641 3626POLYGON ((-71.04123 43.5649...
33387140023780991600000US33871403387140Woodsville 57 2271155 63295POLYGON ((-72.04107 44.1542...
43312900008735671600000US33129003312900Claremont 251117661372323426POLYGON ((-72.41538 43.3802...
53311300023780551600000US33113003311300Charlestown 57 2107485 121062POLYGON ((-72.43447 43.2304...
63378340026297441600000US33783403378340Walpole 57 3152287 27471POLYGON ((-72.43535 43.0751...
ggplot() +
    geom_polygon(
        data = subset(state.df, state_name == "New Hampshire"),
        aes(x = long, y = lat, group = group),
        fill = "white", color = "black"
        ) + 
    geom_sf(
        data = nh.df,
        aes(fill = GEOID)
        ) +
  ggthemes::theme_map() +
  theme(legend.position = "none")
../../../_images/base_35_03.png
load("data/nh.data.RData")

head(nh.data)
A tibble: 6 × 3
GEOIDNAMEpopulation
<chr><chr><dbl>
3300980Alton CDP, New Hampshire 168
3301220Amherst CDP, New Hampshire 709
3301620Antrim CDP, New Hampshire 1232
3301940Ashland CDP, New Hampshire 1353
3303620Bartlett CDP, New Hampshire 104
3304660Belmont CDP, New Hampshire 1814
nh.df %>%
  left_join(
      nh.data, 
      by = c("GEOID" = "GEOID")
  ) -> nh
left_join: added 3 columns (NAME.x, NAME.y, population)
           > rows only in x    0
           > rows only in y  ( 0)
           > matched rows     97
           >                 ====
           > rows total       97
head(nh)
A sf: 6 × 12
STATEFPPLACEFPPLACENSAFFGEOIDGEOIDNAME.xLSADALANDAWATERNAME.ypopulationgeometry
<chr><chr><chr><chr><chr><chr><chr><dbl><dbl><chr><dbl><POLYGON [°]>
13361860023780881600000US33618603361860Pittsfield 57 4114545 0Pittsfield CDP, New Hampshire 1586POLYGON ((-71.34923 43.2990...
23367460026297381600000US33674603367460Sanbornville57 4106641 3626Sanbornville CDP, New Hampshire 581POLYGON ((-71.04123 43.5649...
33387140023780991600000US33871403387140Woodsville 57 2271155 63295Woodsville CDP, New Hampshire 903POLYGON ((-72.04107 44.1542...
43312900008735671600000US33129003312900Claremont 251117661372323426Claremont city, New Hampshire 13016POLYGON ((-72.41538 43.3802...
53311300023780551600000US33113003311300Charlestown 57 2107485 121062Charlestown CDP, New Hampshire 1029POLYGON ((-72.43447 43.2304...
63378340026297441600000US33783403378340Walpole 57 3152287 27471Walpole CDP, New Hampshire 519POLYGON ((-72.43535 43.0751...
ggplot() +
  geom_polygon(
    data = subset(
        state.df, 
        state_name == "New Hampshire"
    ),
    aes(
        x = long, 
        y = lat, 
        group = group
    ),
      fill = "white", 
      color = "black"
    ) +
  geom_sf(
    data = nh,
    aes(fill = population)
    ) +
  coord_sf() +
  scale_fill_viridis_c(option = "viridis") + 
  ggthemes::theme_map() +
  theme(
      legend.position = "bottom",
      legend.text = element_text(size = 14),
      legend.key.width = unit(5, 'cm'),
      title = element_text(size = 20, face = "bold")  
  ) +
  labs(
    fill = "Population Size",
    title = "Population Distribution in New Hampshire's Places",
    subtitle = "(American Community Survey, 2014-2018)"
       )
../../../_images/base_39_03.png
readr::read_csv(
    "https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2019/2019-12-03/tickets.csv"
    ) %>%
  mutate(
    year = lubridate::year(issue_datetime),
    month = lubridate::month(issue_datetime)
         ) %>%
  filter(month == 12, lon > -75.5) %>%
  sample_frac(0.2) -> tickets
Rows: 1260891 Columns: 7
── Column specification ───────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────
Delimiter: ","
chr  (2): violation_desc, issuing_agency
dbl  (4): fine, lat, lon, zip_code
dttm (1): issue_datetime
 Use `spec()` to retrieve the full column specification for this data.
 Specify the column types or set `show_col_types = FALSE` to quiet this message.
mutate: new variable 'year' (double) with one unique value and 0% NA
        new variable 'month' (double) with 12 unique values and 0% NA
filter: removed 1,169,690 rows (93%), 91,201 rows remaining
sample_frac: removed 72,961 rows (80%), 18,240 rows remaining
tickets %>%
  unite(
      display, 
      c(issuing_agency, issue_datetime, fine),
      sep = "; ", 
      remove = FALSE
  ) -> tickets
library(leaflet)
library(htmltools)
library(widgetframe)
Loading required package: htmlwidgets
lst <- list()

leaflet(tickets) %>%
  addTiles() %>%
  addCircles(
      lng = ~ lon, 
      lat = ~ lat, 
      popup = ~htmlEscape(display),
      color = "steelblue", 
      opacity = 0.10
  ) -> leaf01

leaf01 -> lst

htmltools::tagList(lst)
readr::read_csv(
    "https://raw.githubusercontent.com/nytimes/covid-19-data/master/us-counties.csv"
    ) -> covid 
Rows: 2050611 Columns: 6
── Column specification ───────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────
Delimiter: ","
chr  (3): county, state, fips
dbl  (2): cases, deaths
date (1): date
 Use `spec()` to retrieve the full column specification for this data.
 Specify the column types or set `show_col_types = FALSE` to quiet this message.
covid %>%
  filter(
      state == "Ohio", date == "2020-04-17"
  ) -> cov19
filter: removed 2,050,524 rows (>99%), 87 rows remaining
library(housingData)

geoCounty %>%
  filter(state == "OH") %>%
  separate(
      county,
      into = c("countyname", "extra"),
      sep = " County",
      remove = TRUE
  ) %>%
  mutate(
      countyname = stringr::str_to_sentence(countyname)
  ) -> oh
filter: removed 2,987 rows (97%), 88 rows remaining
mutate: changed one value (1%) of 'countyname' (0 new NA)
oh %>%
  left_join(
      cov19, 
      by = c("countyname" = "county")
  ) -> ohcov19

head(ohcov19)
left_join: added 7 columns (fips.x, state.x, date, state.y, fips.y, …)
           > rows only in x    2
           > rows only in y  ( 1)
           > matched rows     86
           >                 ====
           > rows total       88
A data.frame: 6 × 13
fips.xcountynameextrastate.xlonlatrMapStaterMapCountydatestate.yfips.ycasesdeaths
<fct><chr><chr><fct><dbl><dbl><fct><fct><date><chr><chr><dbl><dbl>
139001Adams OH-83.4635938.85662ohioadams 2020-04-17Ohio39001 30
239003Allen OH-84.1082540.77675ohioallen 2020-04-17Ohio39003659
339005Ashland OH-82.2692240.86122ohioashland 2020-04-17Ohio39005 50
439007AshtabulaOH-80.7564741.71017ohioashtabula2020-04-17Ohio39007544
539009Athens OH-82.0405339.34576ohioathens 2020-04-17Ohio39009 31
639011Auglaize OH-84.2219240.56421ohioauglaize 2020-04-17Ohio39011211
ohcov19 %>%
  unite(
      display, 
      c(countyname, cases), 
      sep = ": ",
      remove = FALSE
  ) -> ohcov19

head(ohcov19)
A data.frame: 6 × 14
fips.xdisplaycountynameextrastate.xlonlatrMapStaterMapCountydatestate.yfips.ycasesdeaths
<fct><chr><chr><chr><fct><dbl><dbl><fct><fct><date><chr><chr><dbl><dbl>
139001Adams: 3 Adams OH-83.4635938.85662ohioadams 2020-04-17Ohio39001 30
239003Allen: 65 Allen OH-84.1082540.77675ohioallen 2020-04-17Ohio39003659
339005Ashland: 5 Ashland OH-82.2692240.86122ohioashland 2020-04-17Ohio39005 50
439007Ashtabula: 54AshtabulaOH-80.7564741.71017ohioashtabula2020-04-17Ohio39007544
539009Athens: 3 Athens OH-82.0405339.34576ohioathens 2020-04-17Ohio39009 31
639011Auglaize: 21 Auglaize OH-84.2219240.56421ohioauglaize 2020-04-17Ohio39011211
lst <- list()

leaflet(ohcov19) %>%
  addTiles() %>%
  addCircleMarkers(
    lng = ~ lon, 
    lat = ~ lat, 
    popup = ~htmlEscape(display),
    color = "salmon", 
    opacity = 0.10, 
    radius = ~sqrt(cases)
    ) -> leaf02

leaf02 -> lst

htmltools::tagList(lst)
lst <- list()

leaflet(ohcov19) %>%
  addTiles() %>%
  addCircleMarkers(
      lng = ~ lon, 
      lat = ~ lat, 
      popup = ~htmlEscape(display),
      color = "salmon", 
      opacity = 0.10, 
      radius = ~cases
    ) -> leaf02bad

leaf02bad -> lst

htmltools::tagList(lst)
library(plotly)

lst <- list()

ggplot() +
  geom_point(
    data = mpg,
    mapping = aes(
        x = cty, 
        y = hwy, 
        color = trans)
    ) +
  labs(
      x = "City Mileage",
      y = "Highway Mileage",
      color = "Transmission"
  ) -> pl01

ggplotly(pl01) -> lst

htmltools::tagList(lst)
Attaching package: ‘plotly’
The following objects are masked from ‘package:tidylog’:

    distinct, filter, group_by, mutate, rename, select, slice,
    summarise, transmute, ungroup
The following object is masked from ‘package:ggplot2’:

    last_plot
The following object is masked from ‘package:stats’:

    filter
The following object is masked from ‘package:graphics’:

    layout
library(highcharter)

covid %>%
  filter(
      date == "2020-04-17"
  ) %>%
  rename(
      State = state, 
      `Total Cases` = cases
  ) -> tab1
Registered S3 method overwritten by 'quantmod':
  method            from
  as.zoo.data.frame zoo 
lst <- list()

hchart(
    tab1, 
    "bar", 
    hcaes(
        x = State, 
        y = `Total Cases`
        )
    ) -> hc01

hc01 -> lst
htmltools::tagList(lst)
covid %>%
  filter(
      state %in% c("Ohio", "Florida", "California", "New Jersey", "Ohio", "New York"),
      date >= "2020-03-01"
  ) %>%
  group_by(state, date) %>%
  mutate(
      log_cases = log(sum(cases))
  ) %>%
    ungroup() -> tab2
head(tab2)
A tibble: 6 × 7
datecountystatefipscasesdeathslog_cases
<date><chr><chr><chr><dbl><dbl><dbl>
2020-03-01Alameda California06001103.496508
2020-03-01Humboldt California06023103.496508
2020-03-01Los AngelesCalifornia06037103.496508
2020-03-01Marin California06041103.496508
2020-03-01Napa California06055103.496508
2020-03-01Orange California06059103.496508
tab2 %>%
    select(state, date, log_cases) %>%
    distinct() -> tab2_nodups
head(tab2_nodups)
A tibble: 6 × 3
statedatelog_cases
<chr><date><dbl>
California2020-03-013.4965076
Florida 2020-03-010.6931472
New York 2020-03-010.0000000
California2020-03-023.6375862
Florida 2020-03-020.6931472
New York 2020-03-020.0000000
lst <- list()

hchart(
    tab2_nodups, 
    "line", 
    hcaes(
        x = date, 
        y = log_cases, 
        group = state
        )
    ) -> hc02

hc02 -> lst
htmltools::tagList(lst)
covid %>%
  group_by(county, state, fips) %>%
  filter(date == "2021-11-15") %>% 
  unite(
      Location, 
      c(county, state), 
      sep = ", ", 
      remove = TRUE
  ) -> tab3
head(tab3)
A grouped_df: 6 × 5
dateLocationfipscasesdeaths
<date><chr><chr><dbl><dbl>
2021-11-15Autauga, Alabama0100110407154
2021-11-15Baldwin, Alabama0100337875581
2021-11-15Barbour, Alabama01005 3648 79
2021-11-15Bibb, Alabama 01007 4317 92
2021-11-15Blount, Alabama 0100910536188
2021-11-15Bullock, Alabama01011 1523 44
library(urbnmapr)

data(counties)

head(counties)
A tibble: 6 × 12
longlatorderholepiecegroupcounty_fipsstate_abbvstate_fipscounty_namefips_classstate_name
<dbl><dbl><int><lgl><fct><fct><chr><chr><chr><chr><chr><chr>
-86.9176032.664171FALSE101001.101001AL01Autauga CountyH1Alabama
-86.8165732.660122FALSE101001.101001AL01Autauga CountyH1Alabama
-86.7133932.661733FALSE101001.101001AL01Autauga CountyH1Alabama
-86.7142232.705694FALSE101001.101001AL01Autauga CountyH1Alabama
-86.4131232.707395FALSE101001.101001AL01Autauga CountyH1Alabama
-86.4111732.409946FALSE101001.101001AL01Autauga CountyH1Alabama
counties %>%
  separate(
      county_fips, 
      into = c("stfips", "fips"), 
      sep = 2, 
      remove = FALSE
      ) %>%
  mutate(
      leader = "us", 
      stlower = stringr::str_to_lower(state_abbv)
      ) %>%
  unite(
      code, 
      c(leader, stlower, fips), 
      sep = "-"
      ) -> cdf
head(cdf)
A tibble: 6 × 14
longlatorderholepiecegroupcounty_fipsstfipscodestate_abbvstate_fipscounty_namefips_classstate_name
<dbl><dbl><int><lgl><fct><fct><chr><chr><chr><chr><chr><chr><chr><chr>
-86.9176032.664171FALSE101001.10100101us-al-001AL01Autauga CountyH1Alabama
-86.8165732.660122FALSE101001.10100101us-al-001AL01Autauga CountyH1Alabama
-86.7133932.661733FALSE101001.10100101us-al-001AL01Autauga CountyH1Alabama
-86.7142232.705694FALSE101001.10100101us-al-001AL01Autauga CountyH1Alabama
-86.4131232.707395FALSE101001.10100101us-al-001AL01Autauga CountyH1Alabama
-86.4111732.409946FALSE101001.10100101us-al-001AL01Autauga CountyH1Alabama
cdf %>%
  select(code, county_fips) %>%
  distinct() -> cdf2

head(cdf2)
A tibble: 6 × 2
codecounty_fips
<chr><chr>
us-al-00101001
us-al-00301003
us-al-00501005
us-al-00701007
us-al-00901009
us-al-01101011
tab3 %>%
  left_join(
      cdf2, 
      by = c("fips" = "county_fips")
  ) -> tab4
left_join: added one column (code)
           > rows only in x     117
           > rows only in y  (    9)
           > matched rows     3,133
           >                 =======
           > rows total       3,250
head(tab4)
A grouped_df: 6 × 6
dateLocationfipscasesdeathscode
<date><chr><chr><dbl><dbl><chr>
2021-11-15Autauga, Alabama0100110407154us-al-001
2021-11-15Baldwin, Alabama0100337875581us-al-003
2021-11-15Barbour, Alabama01005 3648 79us-al-005
2021-11-15Bibb, Alabama 01007 4317 92us-al-007
2021-11-15Blount, Alabama 0100910536188us-al-009
2021-11-15Bullock, Alabama01011 1523 44us-al-011
library(viridis)

lst <- list()

hcmap("countries/us/us-all-all", 
      data = tab4,
      name = "COVID-19 Cases", value = "cases",
      joinBy = c("hc-key", "code"),
      borderColor = "steelblue") %>%
  hc_colorAxis(stops = color_stops(10, rev(magma(10)))) %>% 
  hc_legend(layout = "horizontal", align = "right",
            floating = TRUE, valueDecimals = 0, valueSuffix = ""
           ) -> hc03

hc03 -> lst

htmltools::tagList(lst)
Loading required package: viridisLite
tab4 %>%
  filter(
      grepl("-oh-", code)
  ) -> tab5
head(tab5)
A grouped_df: 6 × 6
dateLocationfipscasesdeathscode
<date><chr><chr><dbl><dbl><chr>
2021-11-15Adams, Ohio 39001 4360105us-oh-001
2021-11-15Allen, Ohio 3900317443312us-oh-003
2021-11-15Ashland, Ohio 39005 7413146us-oh-005
2021-11-15Ashtabula, Ohio3900711166217us-oh-007
2021-11-15Athens, Ohio 39009 8083 93us-oh-009
2021-11-15Auglaize, Ohio 39011 7334110us-oh-011
lst <- list()

hcmap("countries/us/us-oh-all", 
      data = tab5,
      name = "COVID-19 Cases", value = "cases",
      joinBy = c("hc-key", "code"),
      borderColor = "steelblue") %>%
  hc_colorAxis(stops = color_stops(10, rev(magma(10)))) %>% 
  hc_legend(layout = "horizontal", align = "right",
            floating = TRUE, valueDecimals = 0, valueSuffix = ""
           ) -> hc04

hc04 -> lst

htmltools::tagList(lst)
library(tidyverse)

data(USArrests)
names(USArrests)
USArrests$statename <- rownames(USArrests)

head(USArrests)
  1. 'Murder'
  2. 'Assault'
  3. 'UrbanPop'
  4. 'Rape'
A data.frame: 6 × 5
MurderAssaultUrbanPopRapestatename
<dbl><int><int><dbl><chr>
Alabama13.22365821.2Alabama
Alaska10.02634844.5Alaska
Arizona 8.12948031.0Arizona
Arkansas 8.81905019.5Arkansas
California 9.02769140.6California
Colorado 7.92047838.7Colorado